Attribute VB_Name = "mShuffleFisherYates"

Option Explicit

'+--------------------------------------------------------------------------+
'|                                                                          |
'|  Modul:          Fisher-Yates Shuffle                                    |
'|  Version:        1.00  (03.03.2010)                                      |
'|  Sprache:        Visual Basic 6.0                                        |
'|  Lizenz:         Keine. Frei verwendbar!                                 |
'|  Entwickler:     Vincenz Dreger                                          |
'|  Homepage:       http://vd-software.inside1.net                          |
'|                                                                          |
'|  Beschreibung:   Mit diesem Modul kann ein String, ByteArray oder        |
'|                  VariantArray zufällig gemischt werden.                  |
'|                                                                          |
'|  Verweis:        http://en.wikipedia.org/wiki/Fisher-Yates_shuffle       |
'|                                                                          |
'|  Hinweis:        Dieser Quellcode kann frei verwendet werden.            |
'|                  Für eventuelle Schäden wird nicht gehaftet.             |
'|                                                                          |
'+--------------------------------------------------------------------------+


Private Sub Main()
  Call Test
End Sub


'Testen der Shuffle-Funktionen
Private Sub Test()
  
  Dim M As Integer
  Dim N As Integer
  
  M = 25       'Maximale Array-Größe
  Dim DA()     'Array dimensionieren
  ReDim DA(M)
  
  'Array mit Buchstaben (A-Z) füllen
  For N = 0 To M
    DA(N) = Chr$(65 + N) + " "
  Next
  
  'Array mischen
  ShuffleArray DA()
  
  'Gemischtes Array ausgeben
  For N = 0 To UBound(DA())
    Debug.Print DA(N);
  Next
  Debug.Print "  ";
  
  'String mischen
  Debug.Print ShuffleString("0123456789ABCDEF")
  
End Sub


'String zu ByteArray wandeln und mischen
Public Function ShuffleString(ByVal InString As String)
  Dim ByteArray() As Byte
  ByteArray() = StrConv(InString, vbFromUnicode)  'String in ByteArray wandeln
  Call ShuffleBytes(ByteArray())                  'ByteArray mischen
  ShuffleString = StrConv(ByteArray(), vbUnicode) 'ByteArray in String wandeln
End Function


'ByteArray zufällig mischen
Public Sub ShuffleBytes(ByteArray() As Byte)
  Dim NN As Long
  Dim UB As Long
  Dim RN As Single
  Randomize                              'Zufallsgenerator initialisieren
  UB = UBound(ByteArray())               'größter Array-Index
  For NN = UB To 0 Step -1               'Array rückwärts durchlaufen
    RN = Round(Rnd * NN)                 'Zufallszahl generieren
    SwapVar ByteArray(RN), ByteArray(NN) 'Array-Inhalt vertauschen
  Next
End Sub


'VariantArray zufällig mischen
Public Sub ShuffleArray(DataArray() As Variant)
  Dim NN As Long
  Dim UB As Long
  Dim RN As Single
  Randomize                              'Zufallsgenerator initialisieren
  UB = UBound(DataArray())               'größter Array-Index
  For NN = UB To 0 Step -1               'Array rückwärts durchlaufen
    RN = Round(Rnd * NN)                 'Zufallszahl generieren
    SwapVar DataArray(RN), DataArray(NN) 'Array-Inhalt vertauschen
  Next
End Sub


'Inhalt von 2 Variabeln vertauschen
Private Function SwapVar(Var1 As Variant, Var2 As Variant)
  Dim Temp As Variant
  Temp = Var2
  Var2 = Var1
  Var1 = Temp
End Function